00100	C   SUBRS.   SCANR, NALF, EDIT, PRESCN
00200	
00300	C ***** MSS SCANNER *************************  
00400		SUBROUTINE SCANR
00500		DIMENSION IQ(10),LRUD(4)
00600		COMMON/ALF/INP(72),ML
00700		COMMON /SC/J,L,MK
00800		1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,IXX,ISEMI,QQ
00900		1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
01000		EQUIVALENCE  (IQ(1),VX(41)),(VX1,VX(1)),(VX2,VX(2)),(LDN,LRUD(4))
01100		DATA IBLA/' '/,LRUD/'L','R','U','D'/
01200	C  FOR LEFT, RIGHT, UP, DOWN, EDIT
01300	      NNUM=-1     
01400	      ISKP=0
01500	      JJ=0  
01600		XMINUS=1.    
01700	C  LEAVES BLANK WHEN REST.
01800	999      DECI=-1  
01900	      M=0   
02000	2799	N=INP(ML)
02100	899   ML=ML+1
02200	781	IF(N.EQ.'/')N=ISEMI
02300	C   FOR MOTIVIC TRANFORMATIONS
02380		IF(N.EQ.'*')GO TO 751
02400		IF(N.EQ.ISEMI)GO TO 751
02500	C  '*' AND '/' ADDED ABOVE 4/18/73
02600		IF(N.NE.IXX)GO TO 22
02650		IF(JN)GO TO 22
02700		IF(ISKP.EQ.0)GO TO 210
02800		ML=ML-1
02900		GO TO 202
03000	22	IF(N.EQ.IBLA)GO TO 4702
03050		IF(N.NE.',')GO TO 510
03100	4702      IF(ISKP)202,2799,2799
03200	512	ML=ML+1
03300		IF(INP(ML).EQ.ISEMI)RETURN
03400		GO TO 512
03500	
03600	510	IF(JN.GE.0)GO TO 173
03700	C  SKIP(JN=+1) IF NOT COMING FROM 'EDIT'
03800		JN=1
03900		DO 702 K=1,4
04000	702	IF(N.EQ.LRUD(K))GO TO 703
04100	C  FINDS L, R, U, D 
04200	C  YOU CAN TYPE THE FULL WORD
04300	703	JJ=JJ+1
04400		IF(K.NE.4)GO TO 77
04450		IF(INP(ML).EQ.'E')K=99
04500	C   'DE'=DELETE
04600	77	IF(N.EQ.'E')K=55
04700	C   'E'= EDIT
04800		IF(N.EQ.'C')K=2222
04900		IF(N.EQ.IXX)K=222
05000	C   'C'=COPY, 'X'=EXIT FROM EDIT MODE
05100		VX(JJ)=K
05200	704	IF(INP(ML).EQ.IBLA)GO TO 2799
05250		IF(INP(ML).EQ.',')GO TO 2799
05300	C  PUT COMMA ERASER IN SCX.
05400		ML=ML+1
05500	C  SO IT WILL SKIP 'D' AND 'EL' IN 'EDIT' AND 'DEL'
05600		GO TO 704
05700	173	K=NALF(N)
05800		IF(N.GT.0)GO TO 1410
05810		IF(K.EQ.18)GO TO 73
05815	C   JUMP IF A REST OR OTHER R'S
05820		IF(MODE.EQ.2)GO TO 144
05860	C YOU CAN TYPE 'S', ETC., FOR SIXTEENTH ETC., RHYTHM.
05900	C   JUMP IF NOT A LETTER
06000		QQ=0
06100		IF(K.LT.8)GO TO 15
06200	C   JUMP IF A POSSIBLE NOTE
06300		IF(K.NE.11)GO TO 16
06400	C   JUMP IF NOT A KSIG
06500	18	N=INP(ML)
06600		ML=ML+1
06700		IF(N.EQ.IBLA)GO TO 18
06750		IF(N.EQ.'S')GO TO 18
06775		IF(N.EQ.'+')GO TO 18
06800		IF(N.EQ.ISEMI)GO TO 20
06900		IF(N.EQ.'-')GO TO 177
06950		IF(N.NE.'F')GO TO 19
07000	177	QQ=-10000.
07100		GO TO 18
07200	19	A=NALF(N)
07300		GO TO 18
07400	20	VX(1)=-A*1000.-99.+QQ
07500	C  -4099=4 SHARPS, -14099=4 FLATS, ETC.
07600		RETURN
07700	16	IF(K.NE.9)GO TO 2
07800		VX(1)=22.
07900	C   FOR EDIT I21 ETC.
08000		GO TO 2799
08100	2	IF(K.NE.13)GO TO 3
08200	C   JUMP IF NOT A MEASURE LINE
08300		VX(1)=-599.
08310		JN=INP(ML)
08320		IF(JN.NE.LDN)GO TO 23
08330		ML=ML+1
08340	C  FOUND 'MDn' -- FOR DOUBLE BARS
08350		JN=0
08360		VX(1)=-609.
08400	23	K=NALF(INP(ML))
08500		IF(K.LE.0)GO TO 512
08505		IF(K.GT.9)GO TO 512
08510		IF(JN.EQ.0)K=K+10
08550	CC	IF(K.LE.9)VX(1)=-599.-K
08575		VX(1)=-599.-K
08600	C  'M2'= A BAR LINE UP 2 STAVES. ETC.
08700		GO TO 512
08800	3	IF(K.GT.16)GO TO 4
08900	C   JUMP IF NOT FOR 'PROXIMITY' MODE
09000		NSWCH=K-15
09100		GO TO 2799
09200	C  TO SWITCH ALWAYS USE OCT.#  /PBF4/  /OE5/  P=PROXIMITY, O=ORDINARY
09500	4	IF(K.NE.20)GO TO 21
09600	C   TRY AGAIN IF NOT A 'T'
09700		IF(INP(ML).GT.0)GO TO 2799
09800	C T12,8/ ETC. MAKES A METER, OR TIME SIG.  POS NUMS ARE NOT LETTERS!
09900		VX(1)=-199.
10000		IF(INP(ML).EQ.'E')VX(1)=-499.
10100		GO TO 51
10200	21	IF(K.NE.19)GO TO 899
10300	C JUMP IF NOT 'S' STEM
10400		VX(1)=-699.
10500	C UP=-699
10600		IF(INP(ML).EQ.LDN)VX(1)=-799.
10700		GO TO 512
10800	C   NEXT IT'S A NOTE OR CLEF
10900	15	NNUM=K-2
11000		IF(NNUM.LE.0)NNUM=NNUM+7
11100		N=INP(ML)
11200		IF(N.NE.'A')GO TO 5
11300	C   JUMP IF NOT BASS CLEF
11400		VX(1)=-299.
11500	51	IF(XMINUS)VX(1)=VX(1)-.5
11600	C TYPE '-BA' FOR INVISIBLE BASS CLEF, ETC.
11700		GO TO 512
11800	5	IF(N.NE.'L')GO TO 6
11900	C   JUMP IF NOT ALTO CLEF
12000		VX(1)=-399.
12100		GO TO 51
12200	6	K=1
12300		IF(NNUM.GT.3)K=2
12400	CC	NNUM=NNUM+NNUM-K
12500	C   FOUND A NOTE
12600	
12700		IF(N.EQ.IXX)GO TO 5410
12800	C FOR GX3/ ETC.
12900		K=NALF(N)
13000		IF(N.GT.0)GO TO 7
13100	C   JUMP IF NOT A LETTER
13200		QQ=100000.
13300		IF(K.EQ.14)GO TO 610
13400		IF(K.EQ.19)GO TO 8
13500	C   JUMP IF NATURAL
13600		QQ=1000.
13700	CC	NNUM=NNUM-1
13800		GO TO 610
13900	8	QQ=10000.
14000	CC	NNUM=NNUM+1
14100	610	ML=ML+1
14200		K=NALF(INP(ML))
14300	7	IF(K.EQ.11)GO TO 5410
14350		IF(K.LT.0)GO TO 5410
14400	C   JUMP IF SEMICOLON OR BLANK
14500		IF(K.NE.24)GO TO 24
14600	CCC  4/76 ???????	ML=ML-1
14700		GO TO 5410
14800	24	JSCA=K-1
14900		ML=ML+1
15000	CC	RRN=0
15100		GO TO 2410
15200	CC5410	RRN=-1
15300	5410	IF(NSWCH.EQ.0)GO TO 2410
15400	C   K=-16 IS A BLANK??
15500		IF(K.EQ.-3)GO TO 277
15550		IF(K.NE.-5)GO TO 7410
15600	277	NOLD=NOLD-6*(K+4)
15700		ML=ML+1
15800	C  -=-3  +=-5  /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
15900	CC7410	IF(NOLD-NNUM.LE.5)GO TO 377
15910	7410	JJ=NOLD-NNUM
15920		IF(JJ.LT.4)GO TO 377
15950		IF(JSCA.LT.7)JSCA=JSCA+1
16000	CC377	IF(NOLD-NNUM.GE.-5)GO TO 2410
16010	377	IF(JJ.GT.-4)GO TO 2410
16050		IF(JSCA.GT.0)JSCA=JSCA-1
16100	C   WILL JUMP TO NEAREST NOTE (CHROM)****  MAY 22,71	(DIATONIC-'75)
16200	2410	JJ=1
16300		VX2=0
16400	CC***  CHANGED TO DIATONIC SCALE (7 NOTES) 12/75 VX1=(JSCA*12+NNUM+QQ)*DBST
16410		VX1=(JSCA*7+NNUM+QQ)*DBST
16500	C  DOUBLE STOPS ARE NEG. NUMBERS
16600		NOLD=NNUM
16700	4410	NNUM=-2
16800		IF(INP(ML).EQ.ISEMI)RETURN
16900	C ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
17000		GO TO 310
17100	210	JJ=JJ+1
17200		IF(JJ.EQ.1)GO TO 3310
17300		XMINUS=1.
17400		VX(JJ)=0
17500	C  'X N1,N2' MAY REPLACE 'REP N1,N2'.  N2=0 BECOMES N2=2
17600		GO TO 310
17700	
17800	C   JUMP IF A LETTER
17900	1410	IF(N.NE.'-')GO TO 14
18000		XMINUS=-1.
18100		GO TO 2799
18102	144	TRIP=0
18105	444	IF(K.EQ.8)VX1=2
18107		IF(K.EQ.4)VX1=.5
18110		IF(K.EQ.5)VX1=8
18115		IF(K.EQ.7)VX1=88
18120		IF(K.EQ.19)VX1=16
18125		IF(K.NE.20)GO TO 244
18126		VX1=12
18127		N=INP(ML)
18129		IF(N.EQ.IBLA)GO TO 344
18131		IF(N.EQ.ISEMI)GO TO 344
18133		TRIP=-1
18150		ML=ML+1
18155		K=NALF(N)
18160		GO TO 444
18220	244	IF(K.EQ.23)VX1=1 
18222		IF(K.EQ.17)VX1=4 
18223	C TS=24TH, TQ=6, TH=3.
18224	C FOR S,E,Q,H,W,D,T RHYTH.  'T'(K=20) =TRIPLET  D=DBL WHL NOTE
18225		IF(TRIP)VX1=VX1*1.5
18226	344	JJ=JJ+1
18228		GO TO 1310
18230	14	ISKP=-1
18300		IF(N.NE.'.')GO TO 79
18400		DECI=M
18500		GO TO 75
18600	79    M=M+1 
18700	      IQ(M)=NALF(N)
18800	
18900	75	IF(N.EQ.ISEMI)GO TO 751
18950		IF(INP(ML).NE.1)GO TO 2799
19000	751	IF(ISKP.EQ.0)RETURN
19100	202   IF(DECI.NE.-1)GO TO 302    
19200	      DECI=0     
19300	      GO TO 402   
19400	302   DECI=M-DECI     
19500	402   RRN=0  
19600	      REXP=M-1    
19700	      IF(M.LT.1)M=1     
19800	      DO 171 K=1,M
19900		IF(REXP.GT.1)GO TO 1
20000		RRV=10
20100		IF(REXP.EQ.0)RRV=1
20200		GO TO 11
20300	1	RRV=10.**REXP
20400	11    RRN=RRN+IQ(K)*RRV 
20500	171     REXP=REXP-1     
20600	      A=10.**DECI 
20700		IF(DECI.EQ.0)A=1.
20800		JJ=JJ+1
20900		VX(JJ)=RRN/A*XMINUS
21000		JN=-JN
21100	C   SETS IT TO -1 FOR L,R,U,D EDIT ROUTINE
21200		IF(MODE.NE.2)XMINUS=1.
21300	C************: MODE #?
21400	C  ONLY ONE - NEEDED FOR RHY.COMPOSITE
21500	1310	IF(INP(ML).NE.1)GO TO 310
21600		VX(JJ+1)=VX(JJ)*2.
21700		JJ=JJ+1
21800		ML=ML+1
21900		GO TO 1310
22000	206	ML=ML+2
22100	3310	VX(1)=-99.
22200	310      ISKP=0
22300	        IF(N.NE.ISEMI)GO TO 999
22400	
22500	    	RETURN
22600	73	JJ=JJ+1
22650		K=INP(ML)
22700		 IF(K.EQ.'E')GO TO 206    
22800	C   NEXT IS FOR A REST/R/ OR /RI/ FOR INVIS. REST  
22810		IF(K.EQ.'D')GO TO 1073
22820	C /RD/ OR /RU/ = REST 6 DOWN OR 6 UP.
22830		IF(K.EQ.'U')GO TO 1173
22900		IF(K.EQ.'I')GO TO 573
22910		IF(K.EQ.'W')GO TO 273
22920	C  /RW/ MAKES WHOLE REST REGARDLESS OF TIME VALUE GIVEN.
22930	C *** ADD NUMBERS LATER *****
22932		K=NALF(K)
22934		IF(K)GO TO 673
22936		IF(K.GE.10)GO TO 673
22940	973	KV=NALF(INP(ML+1))
22941	C  FOR 3-DIG. NUMBS.   CAN TAKE NUM UP TO 999 FOR RESTS.
22942		IF(KV)GO TO 873
22944		IF(KV.GE.10)GO TO 873
22945		ML=ML+1
22946		K=K*10+KV
22948		GO TO 973
22950	873	QQ=K+87
22951		GO TO 473
22952	673	QQ=85
22956		GO TO 373
22960	573	QQ=86
22970		GO TO 473
22980	273	QQ=87
22990	473	ML=ML+1
23000	373	VX(JJ)=QQ
23300		GO TO 4410
23310	1073	QQ=20001
23320		GO TO 473
23330	1173	QQ=20000
23340		GO TO 473
23400	  	END
23500	
23600	
23700	
23800	C	FUNCTION NALF(I)
23900	C	J='A'
24000	C	M=-1
24100	C	IF(I.LT.0)GO TO 10
24200	C	J=' '
24300	C  SEE FORTRAN MAN. FOR VALUES OF NON-NUMS.
24400	C	M=16
24500	C  IF I IS '0', NALF WILL BE 0, 'A'=1
24600	C10	NALF=(I-J)/536870912-M
24700	C	END
24800	
24900	
25000	CC	SUBROUTINE EDIT(JJA)
25100	CC	COMMON/ALF/INP(72),ML /UPDWN/ RL,UD
25200	CC	COMMON /SC/JL,LJ,MK
25300	CC	1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JM,JN,DBST,NFLG,IXX,ISEMI,QQ
25400	CC	1 ,RVX(50),IAMP,A,RRN,B,MODE,IBLA
25500	CC	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
25600	CC	COMMON/RRJJ/RJJ2,RJJ(20)
25700	CC	EQUIVALENCE (RVX1,RVX(1)),(RVX2,RVX(2)),(RVX4,RVX(4))
25800	CC	1,(RVX3,RVX(3)),(RJ6,RJJ(4)),(RJ9,RJJ(7)),(R3,RJQ(1))
25850	CC	1,(RJ5,RJJ(3)),(RJ10,RJJ(8)),(INP2,INP(2)),(INP20,INP(20))
25900	CC	JN=-1
26000	C  THIS IS FLAG IN SCANR
26100	CC	INP20=ISEMI
26150	C  SETS LIMIT IN SCANR
26200	CC	ML=1
26300	CC	RVX2=0
26400	CC	RVX4=0
26500	C E=EDIT(55), C=COPY(2222), X=EXIT(222), DE=DEL(99), LP=LTPN
26600	CC	CALL SCANR
26700	CC	JN=0
26800	CC	R2=RVX2
26900	CC	IF(RVX1.GT.10.)GO TO 7
26910	CC	JA=0
26915	CC	IF(RVX2.NE.0)GO TO 8
26917	CC	IF(INP2.EQ.'P')GO TO 5
26920	CC	RVX2=RL
26925	CC	IF(RVX1.GT.2)RVX2=UD
26930	C  STORES RT-LFT OR UP-DOWN INFO
26946	CC	GO TO 8
26982	C   FOR LIGHT PEN MOVING
27000	CC7	JA=RVX1
27100	CC	IF(JA.EQ.99)R2=0
27200	CC	IF(R2.NE.0)RETURN
27250	CC	IF(JA.NE.55)RETURN
27300	CC5	CALL LPEN(R3,R2,K)
27350	C  ↑↑↑ K NOT USED!
27400	C  CURSOR WILL FIND HORZ POS FOR 55 EDIT.(R3=STF,R2=HORZ) SEE 554 IN MAIN.
27450	CC	IF(JA.EQ.0)CALL EXCH(R2,R3)
27500	CC	RVX1=2.
27600	CC	RVX2=R3-RJJ(1)
27700	CC	RVX3=3.
27800	CC	RJQ(2)=0
27900	CC	RJJ2=R2
28000	C ↑↑↑↑↑↑↑↑↑↑↑↑?????????
28100	C  SO JD WILL BE 0 IN MAIN PROG.
28300	C  FOR EDIT MODE
28900	CC8	IF(JA.EQ.55)RETURN
28905	CC	IF(INP2.EQ.'P')GO TO 17
28910	CC	IF(RVX1.GT.2)GO TO 117
28932	CC	RL=RVX2
28943	CC	IF(RVX4.NE.0)UD=RVX4
28950	CC	GO TO 17
28955	CC117	IF(RVX4.NE.0)RL=RVX4
28977	CC	UD=RVX2
29000	CC17	R2=.00001
29100	CC	JA=0
29200	CC	K=RVX1
29300	CC857	GO TO (1,2,3,4,2),K
29400	CC4	RVX2=-RVX2
29600	C  SKIP OVER CLEFS (JJA=3) IS NOW REMOVED. 6/73
29700	CC3	CALL MVBEAM(RJJ,0,2,2,RVX2)
29800	C  MOVES UP AND DOWN.  HANDLES MINIS, ETC.
30000	CC    IF(JJA.LT.4)GO TO 856
30050	CC	IF(JJA.GT.6)GO TO 856
30100	C   I THINK R2 MUST BE NON-ZERO TO WORK IN EDIT MODE?
30200	CC12	IF(RJ5.EQ.50)GO TO 856
30300	C   50=CRESC.-DECRESC.
30600	CC	RJ5=RJ5+RVX2
30700	C  MOVES 5TH PARAM UP OR DOWN
30800	CC	GO TO 856
30900	CC1	RVX2=-RVX2
31000	CC2	R2=RVX2
31100	CC856	IF(RVX4.EQ.0)GO TO 858
31200	CC	K=RVX3
31300	CC	RVX2=RVX4
31400	CC	RVX4=0
31500	CC	GO TO 857
31600	CC858	IF(R2.EQ..00001)GO TO 7515
31700	CC	IF(JJA.LT.5)GO TO 477
31750	CC	IF(JJA.LE.8)GO TO 5515
31800	CC477	IF(JJA.NE.4)GO TO 7515
31850	CC	IF(RJ6.EQ.0)GO TO 7515
31900	C  ABOVE FOR P1=6 (BEAMS, SLURS, LINES)
32000	CC5515	RJ6=RJ6+R2
32010	CC	IF(JJA.NE.6)GO TO 7515
32100	CC	IF(RJ9.EQ.0)GO TO 7515
32125	CC	IF(RJ10.LT.30)GO TO 7515
32150	CC	IF(JJA.EQ.6)RJ9=RJ9+R2
32200	C  RJ9(P9) IS LOC. OF INNER NOTE IN BEAM RANGE. SKIPS NUMBERS IN P9.
32300	CC7515	RJJ(1)=R2+RJJ(1)
32400	CC	END
32500	
32600		SUBROUTINE PRESCN
32700	C  THIS SORTS OUT NEW INPUT FORMAT - CREATES OLD STYLE.
32800		DIMENSION IR(1)
32900		COMMON/ALF/INP(72),M/XRN/RN(4000)
33000		EQUIVALENCE (IR,RN(2001))
33100	C  CHECK THIS EQUIV.↑↑↑↑
33200	100	IF(ISM)5,55,555
33300	C  -1=PROCESS SOME MORE, 0=1ST TIME, 1=PUT OUT RHYTH
33400	55	JX=0
33500	5	K=0
33600		J=0
33700		I=JX
33800		JX=JX+72
33900	1	K=K+1
34000		M=INP(K)
34100	15	IF(M.EQ.' ')GO TO 1
34150		IF(M.EQ.',')GO TO 1
34200	C  REMOVE BLANKS AND COMMAS
34300		JN=0
34400		IF(M.LT.'0')GO TO 677
34450		IF(M.LE.'9')GO TO 2
34500	677	MM=INP(K+1)
34710	3	IF(M.EQ.'P')GO TO 8
34720		IF(M.EQ.'O')GO TO 8
34730		IF(M.LT.'A')GO TO 777
34740		IF(M.GT.'G')GO TO 777
34750		IF(MM.EQ.'L')GO TO 777
34760		IF(MM.NE.'A')GO TO 8
34800	C  FINDS NOTES, PROX., AND ORDINARY, -- NOT 'BA' OR 'AL'
34900	777	IF(M.NE.'R')GO TO 9
35000		IF(MM.EQ.'E')JN=1
35100	C  CATCHES 'R' 'RI' 'REP'
35200		GO TO 8
35300	9	IF(M.EQ.'/')GO TO 8
35310		IF(M.EQ.';')GO TO 8
35320		IF(M.EQ.'*')GO TO 8
35330		IF(M.EQ.':')GO TO 8
35400		JN=-1
35500	8	J=J+1
35600		 INP(J)=M
35700		IF(M.EQ.'X')JN=1
35800	C  PICKS UP 4X ETC. FOR BOTH NOTES AND RHYTH.
35900		IF(JN.LE.0)GO TO 13
36000	C  PUTS 'REP' INTO RHYTH ALSO
36100		I=I+1
36200		IR(I)=M
36300	13	IF(M.EQ.'/')GO TO 4
36310		IF(M.EQ.';')GO TO 4
36320		IF(M.EQ.'*')GO TO 4
36400		K=K+1
36500		M=INP(K)
36600		GO TO 8
36700	
36800	4	IF(JN.NE.0)GO TO 7
36900		I=I+1
37000		IR(I)=M
37100	7	IF(M.EQ.'/')GO TO 1
37200		IF(M.EQ.';')GO TO 11
37300		IF(M.EQ.'*')GO TO 6
37400	
37500	2	I=I+1
37600		IR(I)=M
37700		K=K+1
37800		M=INP(K)
37900		IF(M.EQ.'.')GO TO 2
37910		IF(M.LT.'0')GO TO 15
37920		IF(M.LE.'9')GO TO 2
38000	C  NO BLANK NEEDED AFTER RHYTH.( /4.AS3/8/ ETC.)
38100		GO TO 15
38200	
38300	11	IF(IR(I).NE.';')IR(I)=';'
38400		ISM=-1
38500		RETURN
38600	C  WE'LL COME BACK FOR MORE.
38700	
38800	6	IF(IR(I).NE.'*')IR(I)='*'
38900		JX=0
39000		ISM=1
39100	C AFTER THIS WE USE RHYTJ DATA.
39200		RETURN
39300	
39400	555	DO 12 K=1,72
39500		M=IR(K+JX)
39600		INP(K)=M
39700		IF(M.EQ.';')GO TO 10
39800	C  MORE THAN ONE LINE
39900	12	IF(M.EQ.'*')GO TO 14
40000	10	JX=JX+72
40100	C  MOVE TO THE NEXT 'LINE'
40200		RETURN
40300	14	ISM=0
40400		END